home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / DESIGN / WINDOWS.PAS < prev    next >
Pascal/Delphi Source File  |  1988-05-04  |  4KB  |  164 lines
  1. unit windows;
  2. interface
  3. uses dos,crt;
  4.  
  5. {$V-}
  6. {$R-}    {Range checking off}
  7. {$B+}    {Boolean complete evaluation on}
  8. {$S+}    {Stack checking on}
  9. {$I+}    {I/O checking on}
  10. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  11.  
  12. type
  13.    string10 = string[10];
  14.    string80 = string[80];
  15.    imagetype  = array [1..4096] of char;
  16.      windimtype = record
  17.                     x1,y1,x2,y2: integer
  18.                   end;
  19.  
  20. const maxwin = 7;  { maximum number of windows open at once }
  21.  
  22.  
  23. var
  24.       a: integer;
  25.   win: { Global variable package }
  26.     record
  27.       dim:    windimtype;  { Current window dimensions }
  28.       depth:  integer;
  29.       stack:  array[1..maxwin] of
  30.                 record
  31.                   image: imagetype;  { Saved screen image }
  32.                   dim:   windimtype; { Saved window dimensions }
  33.                   x,y:   integer     { Saved cursor position }
  34.                 end
  35.     end;
  36.  
  37.   crtmode:      byte      absolute $0040:$0049;
  38.   crtwidth:     byte      absolute $0040:$004A;
  39.   monobuffer:   imagetype absolute $B000:$0000;
  40.   colorbuffer:  imagetype absolute $B800:$0000;
  41.  
  42. procedure fwrite(col,row,attrib:byte;str:string80);
  43. procedure Init_Windows;
  44. procedure Make_Window(x1,y1,x2,y2,t,b:integer);
  45. procedure Remove_Window;
  46. procedure Remove_Windows;
  47. implementation
  48. { ----------------------------------------------------- }
  49. procedure fwrite;
  50. begin
  51. inline
  52. ($1E/$1E/$8A/$86/row/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/
  53.  $03/$C3/$03/$C0/$8B/$F8/$be/$00/$00/$8A/$BE/attrib/
  54.  $8a/$8e/str/$22/$c9/$74/$3e/$2b/$c0/$8E/$D8/$A0/$49/$04/
  55.  $1F/$2C/$07/$74/$22/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/$46/
  56.  $8a/$9A/str/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/
  57.  $89/$1D/$47/$47/$E2/$Ea/$2A/$C0/$74/$10/$BA/$00/$B0/
  58.  $8E/$DA/$46/$8a/$9A/str/$89/$1D/$47/$47/$E2/$F5/$1F);
  59. end;
  60. { -------------------------------------------------------- }
  61. { Call Init_Windows before calling Make_Window or Remove_Window. }
  62.  
  63.  
  64. procedure Init_Windows;
  65.   { Records initial window dimensions }
  66. begin
  67.   with win.dim do
  68.     begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
  69.   win.depth:=0
  70. end;
  71.  
  72. procedure boxwin(x1,y1,x2,y2,t,b:integer);
  73.   { Draws a box, fills it with blanks, and makes it the current }
  74.   { window.  Dimensions given are for the box; actual window is }
  75.   { one unit smaller in each direction.                         }
  76.   { This routine can be used separately from the rest of the    }
  77.   { removable window package.                                   }
  78. var x,y: integer;
  79. begin
  80.   textbackground(b);
  81.   window(1,1,80,25);
  82.   { Top }
  83.   fwrite(x1-1,y1-1,b*16+t,#213);
  84.   for x:=x1+1 to x2-1 do fwrite(x-1,y1-1,b*16+t,#205);
  85.   fwrite(x2-1,y1-1,b*16+t,#184);
  86.  
  87.   { Sides }
  88.   for y:=y1+1 to y2-1 do
  89.    fwrite(x1-1,y-1,b*16+t,#179);
  90.   for y:= y1+1 to y2-1 do
  91.    fwrite(x2-1,y-1,b*16+t,#179);
  92.  
  93.   { Bottom }
  94.   fwrite(x1-1,y2-1,b*16+t,#212);
  95.  
  96.   for x:=x1+1 to x2-1 do fwrite(x-1,y2-1,b*16+t,#205);
  97.   fwrite(x2-1,y2-1,b*16+t,#190);
  98.  
  99.   { Make it the current window }
  100.   window(x1+1,y1+1,x2-1,y2-1);
  101.   clrscr;
  102.   gotoxy(1,1)
  103. end;
  104.  
  105. procedure Make_Window;
  106.   { Create a removable window }
  107.  
  108. begin
  109.   { Increment stack pointer }
  110.   with win do depth:=depth+1;
  111.   if win.depth>maxwin then
  112.     begin
  113.       writeln(' Window nesting error. ');
  114.       exit
  115.     end;
  116.  
  117.   { Save contents of screen }
  118.   if crtmode = 7 then
  119.     win.stack[win.depth].image := monobuffer
  120.   else
  121.     win.stack[win.depth].image := colorbuffer;
  122.  
  123.   win.stack[win.depth].dim := win.dim;
  124.   win.stack[win.depth].x   := wherex;
  125.   win.stack[win.depth].y   := wherey;
  126.  
  127.   { Create the window }
  128.   boxwin(x1,y1,x2,y2,t,b);
  129.   win.dim.x1 := x1+1;
  130.   win.dim.y1 := y1+1;    { Allow for margins }
  131.   win.dim.x2 := x2-1;
  132.   win.dim.y2 := y2-1;
  133.  
  134. end;
  135.  
  136. procedure Remove_Window;
  137.   { Remove the most recently created removable window }
  138.   { Restore screen contents, window dimensions, and   }
  139.   { position of cursor.  }
  140. begin
  141.   if win.depth < 1 then exit;
  142.   if crtmode = 7 then
  143.     monobuffer := win.stack[win.depth].image
  144.   else
  145.     colorbuffer := win.stack[win.depth].image;
  146.   with win do
  147.     begin
  148.       dim := stack[depth].dim;
  149.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  150.       gotoxy(stack[depth].x,stack[depth].y);
  151.       depth := depth - 1
  152.     end
  153. end;
  154.  
  155. Procedure Remove_Windows;
  156. Var
  157.    i : integer;
  158.  
  159. begin
  160.    for i := 1 to 5 do Remove_Window;
  161. end;
  162.  
  163. end.
  164.